→ This file contains some compiler tests and some known bugs in
→ previous compilers.  To my knowledge, all bugs in this file
→ have been patched out of the latest Rutgers version of the UCI
→ version of the Stanford compiler (!).

→					-RL, 8/29/76


→ Herewith some bugs found summer, 76, and fixed.

→ Stanford compiler of 7/76 bombed on this, as P2COND tried to only
→ guard vars on LDLST which were SETQed, but forgot about a SETQ
→ inside of another nested COND.

(DEFPROP RB1
 (LAMBDA (X)
  (FUNC X (COND [L1 (COND [T (SETQ X 5Q)])] [L2 (FUNC)]) X))
EXPR)

→ Used to be a problem referencing special vars if on LDLST when
→ internal lambda came along.

(DEFPROP RB2
 (LAMBDA NIL
  (FUNC L
	((LAMBDA (L)
	  (FUNC))
	 L)
	L))
EXPR)

→ Ditto with SETQ's

(DEFPROP RB3
 (LAMBDA NIL
  (FUNC L (SETQ L 5Q) (FUNC1) L))
EXPR)

→ Ditto with EVAL with arg a CONS of an FSUBR (converted to a CALL,
→ but no clear was done).

(DECLARE (*FSUBR FSBR))

(DEFPROP RB4
 (LAMBDA NIL
  (FUNC L (EVAL (CONS @FSBR L)) L))
EXPR)

→ ARGs and SETARGs which are not inside an LSUBR produce strange
→ and wonderous effects.  RB5 and RB6 should now produce user errors,
→ and have thus been commented.
→(DEFPROP RB5
→ (LAMBDA NIL
→  (ARG 1Q))
→EXPR)

→(DEFPROP RB6
→ (LAMBDA NIL
→  (SETARG 1Q T))
→EXPR)

→ SETARG used to have problems when its value was needed.

(DEFPROP RB7
 (LAMBDA N
  (PRINT (SETARG 1Q T))
  (PRINT (SETARG N T)))
EXPR)

→ Stanford compiler which used ACL in INTERNALLAMBDA bombed on
→ the following since the location of X is changed after Y is
→ pushed.  Fixed by getting rid of ACL and recomputing loc.

(DEFPROP RB8
 (LAMBDA NIL
  ((LAMBDA (X Y) (FUNC)) L1 L2))
EXPR)


→ Found the following March '77 - the problem was that neither the
→ COND nor the SETQ caused the entry for (CAR X) to be removed
→ from the CCLST, so the second (CAR X) used the old value since
→ it was still hanging around.  Fixed by making P2SETQ check to
→ remove any references to old CARs and CDRs of its argument
→ from CCLST.

(DEFPROP RB9
 (LAMBDA (X)
  (FUNC (CAR X) (COND [(SETQ X (CDR X)) (CAR X)])))
 EXPR)

→ The following was found in November 77.  The second (CAR X) was
→ recomputed after it was already decided that the X was no longer
→ necessary.  Fixed by making CSFUN do an ILOC1 instead of an ILOC
→ so that VARLIST is checked.

(DEFPROP RB10
 (LAMBDA (X)
  (FUNC (CAR X) (FUNC (CAR (CAR X)))))
 EXPR)

→ The following was found in November 77.  If the arg to an EQ in
→ a COND was something that needed to be saved and the other arg
→ arg was on the stack, the first arg was moved into the second
→ and the eq test was screwy.  Fixed by patching BOOLEQ1 to move
→ second arg to a free ac if necessary.

(DEFPROP RB11
 (LAMBDA (X)
  (COND [(EQ X (SETQ X 5)) (FUNC X)] [T X]))
 EXPR)

→ From here to the "END OF CTEST" message is the old file CTEST
→ The rest is the old file CBUGS

(DEFPROP DFUNC
         (LAMBDA (L) (LIST (Q DEFPROP) 
			   (CAADR L) 
			   (MCONS (Q LAMBDA) (CDADR L) (CDDR L)) 
			   (Q EXPR))) 
	 MACRO) 
 
(DEFPROP MCONS 
 (LAMBDA (L) 
	 (COND ((NULL (CDDR L)) (CADR L)) 
	       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L)))))) 
 MACRO) 
 
(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO) 
 
(DEFPROP EXPR0 (LAMBDA (LAS) T) EXPR)

(DEFPROP EXPR1 (LAMBDA (X) X) EXPR)
(DEFPROP FEXPR1 (LAMBDA (L) L) FEXPR)
(DEFPROP LEXPR1 (LAMBDA N N) EXPR)

(LAP SUBR1 SUBR) (POPJ P) NIL
(LAP FSUBR1 FSUBR) (POPJ P) NIL
(LAP LSUBR1 LSUBR) (JSP3 *LCALL) (POPJ P) NIL

(DFUNC (EXPR2 X Y)
       (PROG (A UPV)
	     (SETQ A X)
	     (SETQ UPV Y)
	MDT  (RETURN A)
	MDT  (GO UDT)
	     (PRINT FV)
	     (RETURN LAS)))

(DE EXPR3 (Z) (MACRO1 (FEXPR2 Z) (LEXPR2 Z) (FSUBR2 Z) (LSUBR2 Z)))
(DF FEXPR2 (L) L)
(DE LEXPR2 L L)

(LAP FSUBR2 FSUBR) (POPJ P) NIL
(LAP LSUBR2 LSUBR) (JSP 3 *LCALL) (POPJ P) NIL


(DEFPROP MACRO1 (LAMBDA (L) (CONS (Q LIST) (CDR L))) MACRO)

(DE GENFUNS (X)
 (PROG NIL
       (MAPC (FUNCTION (LAMBDA (Y) (F Y Y))) X)
       (MAPC (FUNCTION (LAMBDA (Y) (F Y Y))) X)
       (MAPC (FUNCTION
	      (LAMBDA (Y)
	       (PROG2 (MAPC (FUNCTION (LAMBDA (Z) (F Z Z))) Y)
		      (MAPC (FUNCTION (LAMBDA (Z) (G Z Z))) Y))))
	     (MAPC (FUNCTION (LAMBDA (W)
			      (MAPC (FUNCTION (LAMBDA (X) (F (G X)))) W)))
		   X))))

(DEFPROP VLBUG 
 (LAMBDA NIL
	 (PROG (I) (AND (CAR (SETQ I (CAR I)))
			(SETQ I (CADR I))
			(EQ (CAR I) 4)))) 
EXPR)

(DEFPROP RLOSS1
 (LAMBDA (OP) (PROG NIL (AND SP1 (CDR (RPLACD SP2 (COND (T OP))))))) 
 EXPR)
 
 (DEFPROP RLOSS2
	  (LAMBDA NIL
	   (AND (FUN1)
		(PROG (PROGVAR) (COND ((FUN2) (RETURN PROGVAR))))))
 	  EXPR)

 (DEFPROP RTRICKY
	  (LAMBDA NIL
	   (PROG (A) (SETQ A 1) LOOP (FOO A (SETQ A 2) (BAR)))
 	   EXPR)
 	  EXPR)

(DEFPROP T1 
 (LAMBDA (X)
  (MAPC (FUNCTION (LAMBDA (Y) (MAPC (FUNCTION (LAMBDA (Z) (F Z Z))) Y)))
	X)) 
EXPR)
(DFUNC (T2 X Y) (T3 X Y))

(DEFPROP FOO BAR NLY)

(PRINT (QUOTE (IT IS GONE)))

(DEFPROP T3 
 (LAMBDA (X)
	 (MAPCAR (FUNCTION (LAMBDA (Y)
				   (MAPCAR (FUNCTION (LAMBDA (Z) (F Z Z)))
					   Y)))
	 X)) 
FEXPR)

(LAP FOO SUBR)
	(POPJ P)
	NIL

(DFUNC (T4) T)

(LAP BAR FSUBR)
	(POPJ P)
	NIL

(DEFPROP HENS LAY EGGS)

(LAP BOBBY SUBR) (POPJ P) NIL 

(QUOTE (MIDDLE OF FILE))

(DEFPROP T5 
 (LAMBDA X
  (MAPCAR (FUNCTION (LAMBDA (Y) (MAPCAR (FUNCTION (LAMBDA (Z) (F Z Z)))
	  Y))) X)) 
EXPR)

(QUOTE (END OF CTEST))

→ If EQQ were `EQ' then BUG1 would give the same error as BUG3 and BUG4.
→ As it is, however, it give an `(X . 13) LOSTVAR-ILOC1' error.

(DEFPROP BUG1
	 (LAMBDA (NAME)
		 (PROG (X)
		       (SETQ X
			     (APPEND
			      X
			      (PROG (&V)
			       LOOP (COND ((NOT (EQQ (SETQ X (READCH))
						     T))
					   (SETQ &V
						 (APPEND &V (LIST X))))
					  (T (RETURN &V)))
				    (GO LOOP))))))
	 EXPR)

→ If NACS is set to 3 then BUG2 results in a NOAC-RESTORE error.

(DEFPROP BUG2
	 (LAMBDA NIL
		 (PROG (X)
		       (SETQ X
			     (CONS X
				   (PROG (&V)
				    LOOP (COND ((SETQ X T)
						(SETQ &V (LIST X)))
					       (T (RETURN &V)))
					 (GO LOOP))))))
	 EXPR)

→ BUG3 and BUG4 both produce extra pushes and pops.

(DEFPROP BUG3 (LAMBDA NIL (PROG (X) (CONS X (COND ((SETQ X T) X))))) EXPR)

(DEFPROP BUG4 (LAMBDA (X) (PROG NIL (CONS X (COND ((SETQ X T) X))))) EXPR)

→ This bug comes from Hearn.  It involves a variable being loaded as an 
→ argument by an EXCH, which leaves the only copy in the AC, then protected
→ by pushing which gives trouble.

→ CB1 is a simple case which produces a MOVE then a MOVEM.

(DEFPROP CB1 (LAMBDA (A) (PROG (B) TAG (SETQ A A) (RETURN B))) EXPR)

→ CB2 generates the erronious EXCH then stops.

(DEFPROP CB2
	 (LAMBDA (A) (PROG (B) TAG (SETQ B A) (SETQ A A) (RETURN B)))
	 EXPR)

→ CB3 continues from the error of CB2 into a disaster.

(DEFPROP CB3
	 (LAMBDA (A)
		 (PROG (B)
		  TAG1 (SETQ B A)
		       (SETQ A A)
		       (COND ((FUN A B) (GO TAG3)))
		  TAG2 (RETURN B)
		  TAG3))
	 EXPR)

→ Daryl Lewis of U.C. Irvine contributed the folling bug.
→ The L is clobbered by the internal lambda to NIL.
→ This was fixed by modification of INTERNALLAMBDA on 24July72.

(DE IRVBUG NIL (CONS L ((LAMBDA (L) NIL) NIL)))

→ This bug has been patched out of the compiler by keeping varlist empty.

(DEFPROP VLBUG 
 (LAMBDA NIL
	 (PROG (I) (AND (CAR (SETQ I (CAR I)))
			(SETQ I (CADR I))
			(EQ (CAR I) 4)))) 
EXPR)

→ This appeared in the course of debugging a new compiler.  An element
→ of the CCLST is saved in the middle of the computation of a NOT.
→ This is because the CCLST is cleared by OUTJMP but not by P2BOOL.

(DEFPROP T11 
	 (LAMBDA (X) (FUN (CAR X) (CONS (NOT X) X)))
	 EXPR)

→ This file was recovered from Summer 71 and expanded.
→ I believe that the bugs of RLOSS and CATEGORISE have been fixed.
→ HEARNBUG is the original form of CB1,2and3 in CBUGS.
→ VLBUG been patched by keeping VARLIST empty and the function has been
→ copied into CBUGS.

(DEFPROP VLBUG 
 (LAMBDA NIL
	 (PROG (I) (AND (CAR (SETQ I (CAR I)))
			(SETQ I (CADR I))
			(EQ (CAR I) 4)))) 
EXPR)

(DEFPROP RLOSS 
 (LAMBDA (OP) (PROG NIL (AND SP1 (CDR (RPLACD SP2 (COND (T OP))))))) 
EXPR)
 
(DEFPROP CATEGORISE
 (LAMBDA NIL
  (PROG (CATEG CATEGORY)
        (PROG (&V)
         LOOP (SETQ &V
                    (AND (SETQ CATEG (QUOTE ""))
                         (PROG (&V)
                          LOOP (SETQ &V (SETQ CATEG (CAT CATEG (READCH))))
                               (COND ((SETQ CATEGORY (COMPARE (AT CATEG) CATEGLIST)) (RETURN &V))
                                     (T (GO LOOP)))))))))
EXPR)
→ This bug comes from Hearn.  It involves a variable being loaded as an 
→ argument by an EXCH, which leaves the only copy in the AC, then protected
→ by pushing which gives trouble.

(DEFPROP HEARNBUG
 (LAMBDA (A B)
  (PROG (C E I J K M N VAR)
	(COND ((OR (ATOM B) (ATOM A)) (RETURN 1)))
	(COND ((GEQ (CDAAR A) (CDAAR B)) (GO A0)))
	(SETQ I A)
	(SETQ A B)
	(SETQ B I)
   A0	(SETQ VAR (CAAAR A))
	(SETQ M (CDAAR A))
	(SETQ N (CDAAR B))
	(SETQ A (REDLIST A))
	(SETQ B (REDLIST B))
   A1	(SETQ E (GFINV (CAR B)))
   A2	(SETQ C (GFTIMES (CAR A) E))
	(SETQ A (RPLACA A 0))
	(SETQ I (CDR A))
	(SETQ J (CDR B))
	(SETQ K 1)
   G0142(COND ((GREATERP K N) (GO A4)))
	(RPLACA I (GFDIF (CAR I) (GFTIMES C (CAR J))))
	(SETQ I (CDR I))
	(SETQ J (CDR J))
	(SETQ K (PLUS K 1))
	(GO G0142)
   A4	(COND ((NEQ (CAR A) 0) (GO A5)))
	(SETQ A (CDR A))
	(SETQ M (DIFFERENCE M 1))
	(COND ((GREATERP M 0) (GO A4)))
	(COND ((EQUAL (CAR A) 0) (GO A6)) (T (RETURN 1)))
   A5	(COND ((GEQ M N) (GO A2)))
	(SETQ I A)
	(SETQ A B)
	(SETQ B I)
	(SETQ I N)
	(SETQ N M)
	(SETQ M I)
	(GO A1)
   A6	(SETQ I B)
	(SETQ E (GFINV (CAR B)))
   A7	(RPLACA I (GFTIMES E (CAR I)))
	(COND ((SETQ I (CDR I)) (GO A7)))
	(SETQ I B)
   A8	(RPLACA I (CONS (CONS VAR N) (CAR I)))
   A9	(COND ((EQUAL (SETQ N (DIFFERENCE N 1)) 0)
	       (RETURN (PROG2 (RPLACD I
				      (COND ((EQUAL (CADR I) 0) NIL)
					    (T (CADR I))))
			      B))))
	(SETQ I (CDR I))
	(COND ((EQUAL (CAR I) 0) (GO A9)) (T (GO A8)))))
 EXPR)
→ This bug comes from John Allan.  It is a result of RSL getting
→ rebound in the non value boolean case.

(DEFPROP JRABUG
 (LAMBDA (X) (COND ((NULL X) (ONE)) ((MEMQ NIL X) (TWO)))) 
EXPR)

→ This is a simple error in P2PROG2.  The case for test is screwed up.

(DEFPROP BLFBUG
 (LAMBDA NIL
  (PROG (HOLDL SUFF SL)
        (COND ((AND (PROG2 (SETQ SL (STRLEN SUFF))
			   (NOT (*LESS HOLDL (*PLUS SL 2))))))))) 
 EXPR)

→ I found this bug in the process of debugging JRABUG and BLFBUG.
→ The last occurence of G is free but is not recognized as such.
→ This bug is classic dating all the way back to Blatt compilers.

(DEFPROP NEXTSYM T *FSUBR)

(DE WDBUG (XPR VALAC TEST)
 (PROG NIL
       (CLEARBOTH)
       (COND ((NOT (NULL VALAC))
	      (RETURN (PROG (CTAG RSL G)
			    (PUTPROP (SETQ G (NEXTSYM TAG)) T (QUOTE SET))
			    (BOOLEXPR XPR VALAC (CONS T G))
			    (RETURN (TESTJUMP (BOOLVALUE VALAC G)
					      TEST))))))
       (BOOLEXPR XPR VALAC TEST)
       (COND ((NULL TEST) (OUTENDTAG G)))))

(COMMENT I DON'T KNOW WHAT THIS IS - WD)

→ (DE P1LAM (XPR) (P1 (CONS (GENFUN (CAR XPR)) (CDR XPR))))